home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
MATH
/
ROUND
/
ROUND.PAS
Wrap
Pascal/Delphi Source File
|
1993-08-03
|
3KB
|
120 lines
{
Unfortunately, Turbo Pascal does not do a very good job of rounding
numbers when using the built-in REAL data type. For instance:
WRITELN(87.75:8:1);
returns:
87.7 Yikes!
This program contains two routines to round REALs and demonstrates the
problem with the PASCAL str function (which also applies to WRITELN).
The function HalfAdjust will round 5 or more up and 4 or less down.
The function rounded will round 6 or more up and 4 or less down and 5
will round to an even value (the most correct mathematically).
John Lucas [70441,2451]
}
{$N-}
function HalfAdjust(r : real; width, decimals : integer) : string;
{ always round up on "5" }
var
temp : string;
half : real;
begin
case decimals of
0 : half := 0.5;
1 : half := 0.05;
2 : half := 0.005;
3 : half := 0.0005;
4 : half := 0.00005;
5 : half := 0.000005;
6 : half := 0.0000005;
7 : half := 0.00000005;
8 : half := 0.000000005;
9 : half := 0.0000000005;
10 : half := 0.00000000005;
11 : half := 0.000000000005;
else half := 0.0;
end;
if r<0 then
r := r-half
else
r := r+half;
str(r:0:11,temp);
if decimals=0 then
dec(temp[0],12)
else
dec(temp[0],11-decimals);
dec(width,length(temp));
if width>0 then begin
move(temp[1],temp[succ(width)],length(temp));
inc(temp[0],width);
fillchar(temp[1],width,' ')
end;
HalfAdjust := temp
end; {HalfAdjust}
function rounded(r : real; width, decimals : integer) : string;
{ round on "5" to an even value }
var
temp : string;
point : integer;
i : integer;
begin
str(r:0:11,temp);
insert('0',temp,1);
point := length(temp)-11;
delete(temp,point,1);
if temp[point+decimals]='5' then
if odd(ord(temp[point+decimals-1])) then
for i := pred(point) downto 1 do
if temp[i]='9' then
temp[i] := '0'
else
begin
inc(temp[i]);
break
end;
insert('.',temp,point);
if temp[1]='0' then
delete(temp,1,1);
if decimals=0 then
dec(temp[0],12)
else
dec(temp[0],11-decimals);
dec(width,length(temp));
if width>0 then begin
move(temp[1],temp[succ(width)],length(temp));
inc(temp[0],width);
fillchar(temp[1],width,' ')
end;
rounded := temp
end; {rounded}
var
q,r : real;
i : integer;
procedure show(r : real);
var
rh,rr,rs : string;
begin
str(r:12:0,rs);
rh := HalfAdjust(r,12,0);
rr := rounded(r,12,0);
write(r,rh,rr,rs);
if rs<>rh then write(' wrong');
writeln;
end;
begin
q := 0.499999999;
r := 0.50;
writeln(' Value HalfAdjust() rounded() str()');
for i := 90 to 99 do begin
show(q+i);
show(r+i);
end;
end.